package SerialLibs::Marantz;
$SerialLibs::Marantz::VERSION = '0.02';

################################################################################
#
#	Heavily based upon RFLibs::Aquos which was:
#       Created by Ronald Frazier
#       http://www.ronfrazier.net
#
#	Modified by Wayne Thomas to control Marantz AVR equipment instead of Sharp
# 	Aquos TV equipment.
#       Feel free to do anything you want with this, as long as you
#       include the above attribution.
#
#	Todo:	Tidy up code
#		SendCommand
#		Allow seperate audio and video inputs
#
################################################################################

use strict;
use Device::SerialPort;
use Time::HiRes qw(sleep);
#use List::MoreUtils qw(firstidx);

my %debuglevels = ('NONE' => 0, 'ERROR' => 1 , 'WARN' => 2, 'INFO' => 3);
#my @inputs = ('', 'TV', 'DVD', 'VCR', '', 'DSS', '', '', 'USB', 'AUX1', 'AUX2', 'CD', 'CD-R', '', 'TAPE', 'TUNER', 'FM', 'AM', '', 'XM', 'SIRIUS');
my %input_to_code = ('TV' => 1, 'DVD' => 2, 'VCR' => 3, 'DSS' => '5', 'USB' => 8, 'AUX1' => 9, 'AUX2' => 'A', 'CD' => 'B', 
			'CD-R' => 'C', 'TAPE' => 'E', 'TUNER' => 'F', 'FM' => 'G', 'AM' => 'H', 'XM' => 'I', 'SIRIUS' => 'J');
my %code_to_input = (1 => 'TV', 2 => 'DVD', 3 => 'VCR', 5 => 'DSS', 8 => 'USB', 9 => 'AUX1', 'A' => 'AUX2', 'B' => 'CD', 
			'C' => 'CD-R', 'E' => 'TAPE', 'F' => 'TUNER', 'G' => 'FM', 'H' => 'AM', 'I' => 'XM', 'J' => 'SIRIUS');
#my @index = ('', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K');

sub new
{
        my ($classtype, $serialport_device) = @_;

        my $self = {};
        bless $self, $classtype;

        return $self->init($serialport_device);
};

sub kill
{
        my ($self) = @_;

        return $self->{port}->close;
};

sub init
{
	my ($self, $serialport_device) = @_;

	my $port = Device::SerialPort->new($serialport_device) or return 0;
	$port->baudrate(9600);
	$port->parity("none");
	$port->databits(8);
	$port->stopbits(1); 
	$port->handshake("none");
	$self->{port} = $port;

	$self->debug('WARN');

	return $self;
};

sub debug
{
	my ($self, $debug) = @_;
	$self->{debug} = $debug if defined($debug);
	return $self->{debug};
};

sub debugprint
{
	my ($self, $level, @msg) = @_;
	return if $debuglevels{$self->{debug}} < $debuglevels{$level};
	print STDERR @msg;
};

sub power
{
	my ($self, $value, $zone) = @_;
	$self->debugprint('INFO', "$zone\n");
        my $cmd = ( $zone == 1 ? '@MPW:' : '@PWR:');
	$value = ($value == 1 ? '2' : '1') if $value ne '';
	my $result = $self->getset($cmd, $value);
	return $result if ($result eq 'ERR');
	$result = (substr($result, 5, 1) == 2 ? 'ON' : 'OFF');
	return "AMP $result";
};

sub volume
{
	my ($self, $value, $zone) = @_;
	$self->debugprint('INFO', "value = \'$value\'\n");
	my $shift = 72;
	my $cmd = ( $zone == 1 ? '@MVL:' : '@VOL:');	
	$shift = 90 if ($cmd eq '@MVL:');
	$cmd = $cmd.'0' unless ($value eq '');
	my $result;
	if ($value ne '') {
		return 'ERR' if ($value > 100 || $value < 0);
		$value = 90 if ($value > 90);
		$value = $value - $shift;
		$value = sprintf("%+03d", $value);
		$value = '-ZZ' if ($value eq '-72' && $cmd eq '@VOL:');
		$self->debugprint('INFO', "value = \'$value\'\n");
		$result = $self->set($cmd, $value);
	}
	else {
		$result = $self->get($cmd);
	}
	return $result if ($result eq 'ERR');
	$result = substr($result, 5, 3);
	$result = '-72' if ($result eq '-ZZ');
	$result = $result + $shift;
	return "VOLUME $result";
};

sub adjust_volume
{
	my ($self, $adjust, $zone) = @_;
	my $shift = 72;
	my $cmd = ( $zone == 1 ? '@MVL:' : '@VOL:');
	$shift = 90 if ($cmd eq '@MVL:');
	my $current = $self->get($cmd);
        $self->debugprint('INFO', "Current Volume = $current\n");
	return $current if ($current eq 'ERR');
        $self->debugprint('INFO', "Return String = $current\n");
	$current = substr($current, 5, 3);
	$current = '-72' if ($current eq '-ZZ');
        $self->debugprint('INFO', "Return Value = $current\n");
	$current = $current + $shift;
        $self->debugprint('INFO', "Percent Volume = $current\n");
#	return $self->set($cmd, "-99") if ($current eq '00' && $adjust < 0);
	my $new = $current + ($adjust*5);
	$new = 90 if ($new > 90);
        $new = 0 if ($new < 0);
        my $cmd = $cmd . '0';
	$new = $new - $shift;
	$new = sprintf("%+03d", $new);
	$new = '-ZZ' if ($new eq '-72' && $cmd eq '@VOL:0');
	my $result = $self->set($cmd, "$new");
	return $result if ($result eq 'ERR');
	$result = substr($result, 5, 3);
	$result = '-72' if ($result eq '-ZZ');
	$result = $result + $shift;
	return "VOLUME $result";
};

sub mute
{
	my ($self, $value, $zone) = @_;
        my $cmd = ( $zone == 1 ? '@MAM:' : '@AMT:');
        $value = ($value == 1 ? '2' : '1') if ($value ne '');
	my $result = $self->getset($cmd, $value);
	return $result if ($result eq 'ERR');
	$result = (substr($result, 5, 1) == 2 ? 'ON' : 'OFF');
	return "MUTE $result";
};

sub toggle_mute
{
	my ($self, $zone) = @_;
        my $cmd = ( $zone == 1 ? '@MAM:' : '@AMT:');
	my $result = $self->set($cmd, '0');
	return $result if ($result eq 'ERR');
	$result = (substr($result, 5, 1) == 2 ? 'ON' : 'OFF');
	return "MUTE $result";
};

sub input
{
	my ($self, $value, $zone) = @_;
	my $code;
	$self->debugprint('INFO', "Marantz Input $value\n");
	my $cmd = ( $zone == 1 ? '@MSC:' : '@SRC:');
        if ($value ne '') {
		$code = $input_to_code{$value};
        	return 'NOP' if $code == -1;
	};
#	$code = firstidx {$_ eq $value} @inputs;
#	return 'NOP' if ($code == -1);
#	$value = $index[$code];
	$value = $value.$value unless ($value eq '');
	my $result = $self->getset($cmd, $value);
	$result = substr($result, 6, 1);
	$result = $code_to_input{$result};
#	$code = firstidx {$_ eq $result} @index;
#	$result = $inputs[$code];
	return "AMP_IN $result";
};

sub get
{
	my ($self, $cmd) = @_;
	return $self->sendCommand("$cmd?");
};

sub set
{
	my ($self, $cmd, $value) = @_;
	return $self->sendCommand("$cmd$value");
};

sub getset
{
	my ($self, $cmd, $value) = @_;
	my $old = $self->get($cmd);
	return $old unless $value ne '';
	my $new = $cmd.$value;
        $self->debugprint('INFO', "Current Value = $old\nNew Value    = $new\n");
	return $old if $new eq $old;
	return $self->set($cmd, $value);
};


sub sendCommand
{
	my ($self, $cmd) = @_;
	foreach (1..3)
	{
		my $result = $self->sendCommand_inner($cmd);
                $self->debugprint('INFO', "Marantz No Response\n") if $result eq 'NORESPONSE';
                next if $result eq 'NORESPONSE';
		$self->debugprint('INFO', "$result\n");
		my $compare = substr($result, 0, 3);
		$self->debugprint('INFO', "$compare\n");
		$self->debugprint('INFO', "Marantz Bad Response\n") unless $cmd =~ /($compare)/;
		next unless $cmd =~ /($compare)/;

		#occasionally we get non-ascii characters mixed in with the data. If so, we need to reprompt
#		if ($result =~ /([^a-zA-Z0-9_\- ])/)
#		{
#			$self->debugprint('ERROR', "Marantz Received non ASCII character in response: '$1' Hex=".ord($1)."\n");
#			redo;
#		};

		return $result;
	};
        $self->debugprint('INFO', "Marantz Three Failed Send Attempts\n");
	return 'ERR';
};

sub sendCommand_inner
{
	my ($self, $cmd) = @_;
	$self->debugprint('INFO', "Marantz\t\t$cmd\n");

	#clear the buffer
	while(1)
	{
		my ($bytes, $read) = $self->{port}->read(1);
		last if $bytes == 0;
		$self->debugprint('WARN', "Marantz $bytes byte(s) -->$read<-- cleared from buffer\n");
	};


	$self->{port}->write("$cmd\r");

	my $data = '';
	my $start = Time::HiRes::time();
	while(1)
	{
		if ((Time::HiRes::time() - $start) >= 1)
		{
			$self->debugprint("INFO", "Marantz read timeout with partial data: -->$data<--\n") if ($data ne '');
                        $self->debugprint("INFO", "Marantz read timeout with no data\n") if ($data eq '');
			return 'NORESPONSE';
		};

		my ($bytes, $read) = $self->{port}->read(1);
		next if $bytes == 0;
		return $data if ($read eq "\r");
		$data .= $read;
	};	
};

return 1;

